스포츠활동 시계열 분석

충청남도

library(fpp2)  # 시계열 분석을 위한 패키지
library(gridExtra)
theme_set(theme_grey(base_family='NanumGothic'))  # ggplot 한글 깨짐 방지
options(scipen = 999)  # to remove scientific notation

전체 스포츠 한 그림에

dir <- "/Users/jaeyonglee/Documents/College/RStudio/Culture/real_proper_ts_data/chungnam/"
items <- c("골프","레저스포츠","스키","자전거","헬스")

# 데이터 불러오기
temp1 <- read.csv(paste(dir,items[1],".csv",sep=""), header=T)
temp2 <- read.csv(paste(dir,items[2],".csv",sep=""), header=T)
temp3 <- read.csv(paste(dir,items[3],".csv",sep=""), header=T)
temp4 <- read.csv(paste(dir,items[4],".csv",sep=""), header=T)
temp5 <- read.csv(paste(dir,items[5],".csv",sep=""), header=T)

# ts 개체로 만들기
temp1_ts <- ts(temp1['avg'][,1], start=2018, frequency=12)  # [,1]은 univariate으로 정확히 해주기 위함임
temp2_ts <- ts(temp2['avg'][,1], start=2018, frequency=12)
temp3_ts <- ts(temp3['avg'][,1], start=2018, frequency=12)
temp4_ts <- ts(temp4['avg'][,1], start=2018, frequency=12)
temp5_ts <- ts(temp5['avg'][,1], start=2018, frequency=12)

# 시각화
temp_plot <- autoplot(temp1_ts, series = items[1]) +
  autolayer(temp2_ts, series = items[2]) +
  autolayer(temp3_ts, series = items[3]) +
  autolayer(temp4_ts, series = items[4]) +
  autolayer(temp5_ts, series = items[5]) +
  labs(title = paste("스포츠 종목별 개인 취급액 시계열 (충청남도)\n",sep=""),
       caption = "(개인 취급액 = 동일 년월의 취급액의 합 / 이용건수)",
       x = "시간",
       y = "취급액") +
  labs(color='스포츠 종목 구분') +
  theme(
    plot.title = element_text(hjust = 0.5), # 가운데 정렬
    plot.caption = element_text(hjust = 0)  # 왼쪽 정렬
    )
print(temp_plot)

스포츠 종목별 시계열 분해 및 예측

dir <- "/Users/jaeyonglee/Documents/College/RStudio/Culture/real_proper_ts_data/chungnam/"
items <- c("전체 스포츠활동","골프","레저스포츠","스키","자전거","헬스")

for(item in items){
  # 데이터 불러오기
  if(item == "전체 스포츠활동"){
    temp <- read.csv(paste(dir,"all_sports.csv",sep=""), header=T)
  }else{
    temp <- read.csv(paste(dir,item,".csv",sep=""), header=T)
  }
  
  # ts 개체로 만들기
  temp_ts <- ts(temp['avg'][,1], start=2018, frequency=12)  # [,1]은 univariate으로 정확히 해주기 위함임

  # auto.arima로 최적의 pdq, PDQ 찾기
  fit_arima <- auto.arima(temp_ts)
  cat(paste(item,"의 개인 취급액 시계열 (충청남도)\n", sep=""))
  print(fit_arima)
  
  # residual assumption 확인
  checkresiduals(fit_arima)
  
  fit_arima %>% forecast(h=12, level=80) %>% autoplot() +
    labs(title = paste(item,"의 개인 취급액 시계열 (충청남도)",sep=""),
         subtitle = "미래 1~12개월(1년)에 대한 ARIMA의 예측치와 80% 신뢰구간",
         caption = "(개인 취급액 = 동일 년월의 취급액의 합 / 이용건수",
         x = "시간",
         y = "취급액") +
    theme(
      plot.title = element_text(hjust = 0.5), # 가운데 정렬
      plot.subtitle = element_text(hjust = 0.5),
      plot.caption = element_text(hjust = 0)  # 왼쪽 정렬
      ) -> arima_plot
  print(arima_plot)
  
  # STL decomposition
  fit_stl <- stl(temp_ts,s.window="periodic", robust=T)
  autoplot(fit_stl) +
    labs(title = paste(item,"의 개인 취급액 시계열 (충청남도)",sep=""),
         subtitle = "STL decomposition",
         caption = "(개인 취급액 = 동일 년월의 취급액의 합 / 이용건수)",
         x = "시간",
         y = "취급액") +
    theme(
      plot.title = element_text(hjust = 0.5), # 가운데 정렬
      plot.subtitle = element_text(hjust = 0.5),
      plot.caption = element_text(hjust = 0)  # 왼쪽 정렬
      ) -> stl_plot
  print(stl_plot)
}

전체 스포츠활동의 개인 취급액 시계열 (충청남도)
Series: temp_ts 
ARIMA(0,0,1)(1,1,0)[12] 

Coefficients:
         ma1     sar1
      0.6279  -0.4696
s.e.  0.1256   0.1454

sigma^2 = 303128424448777:  log likelihood = -724.38
AIC=1454.76   AICc=1455.43   BIC=1459.83

    Ljung-Box test

data:  Residuals from ARIMA(0,0,1)(1,1,0)[12]
Q* = 5.2854, df = 8, p-value = 0.7267

Model df: 2.   Total lags used: 10

골프의 개인 취급액 시계열 (충청남도)
Series: temp_ts 
ARIMA(0,0,0)(1,1,0)[12] with drift 

Coefficients:
         sar1      drift
      -0.4282  421653.54
s.e.   0.1657   66275.48

sigma^2 = 44383662915273:  log likelihood = -685.42
AIC=1376.85   AICc=1377.51   BIC=1381.91

    Ljung-Box test

data:  Residuals from ARIMA(0,0,0)(1,1,0)[12] with drift
Q* = 25.105, df = 8, p-value = 0.001492

Model df: 2.   Total lags used: 10

레저스포츠의 개인 취급액 시계열 (충청남도)
Series: temp_ts 
ARIMA(0,1,0) 

sigma^2 = 56751987114798:  log likelihood = -879.94
AIC=1761.89   AICc=1761.97   BIC=1763.82

    Ljung-Box test

data:  Residuals from ARIMA(0,1,0)
Q* = 14.347, df = 10, p-value = 0.1577

Model df: 0.   Total lags used: 10

스키의 개인 취급액 시계열 (충청남도)
Series: temp_ts 
ARIMA(1,0,0)(1,1,0)[12] 

Coefficients:
         ar1     sar1
      0.7534  -0.4463
s.e.  0.1067   0.1428

sigma^2 = 507225662264:  log likelihood = -596.51
AIC=1199.03   AICc=1199.69   BIC=1204.09

    Ljung-Box test

data:  Residuals from ARIMA(1,0,0)(1,1,0)[12]
Q* = 5.2172, df = 8, p-value = 0.7341

Model df: 2.   Total lags used: 10

자전거의 개인 취급액 시계열 (충청남도)
Series: temp_ts 
ARIMA(0,1,1)(0,1,1)[12] 

Coefficients:
          ma1     sma1
      -0.4460  -0.4469
s.e.   0.1765   0.2067

sigma^2 = 2378335129615:  log likelihood = -611.45
AIC=1228.9   AICc=1229.59   BIC=1233.89

    Ljung-Box test

data:  Residuals from ARIMA(0,1,1)(0,1,1)[12]
Q* = 9.2939, df = 8, p-value = 0.3181

Model df: 2.   Total lags used: 10

헬스의 개인 취급액 시계열 (충청남도)
Series: temp_ts 
ARIMA(1,0,0) with non-zero mean 

Coefficients:
         ar1      mean
      0.5164  46940436
s.e.  0.1227   1364402

sigma^2 = 24321107768372:  log likelihood = -874.3
AIC=1754.6   AICc=1755.1   BIC=1760.46

    Ljung-Box test

data:  Residuals from ARIMA(1,0,0) with non-zero mean
Q* = 6.0666, df = 8, p-value = 0.6398

Model df: 2.   Total lags used: 10